home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Panorama / Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].zip / Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].adf / ModulaII / Dhrystone / Dhry.Mod
Text File  |  1988-03-15  |  16KB  |  493 lines

  1. MODULE Dhrystone;
  2.  
  3. (*---------------------------------------------------------------------------
  4.                         "DHRYSTONE" Benchmark Program
  5.                         -----------------------------
  6.  
  7.     Version: Commodore Amiga Benchmark Modula-2. Easily ported from
  8.              the TDI Modula-2/1 version.
  9.     Date:    23-Mar-1987
  10.     Author:  Reinhold P. Weicker (ADA version)
  11.  
  12.     Translated from ADA by Joergen Thomsen. Compuserve: 71310,2206
  13.     ADA version published in
  14.     Communications of the ACM, October 1984, Vol. 27 Number 10
  15.  
  16.   --------------------------------------------------------------------------- 
  17.     Original ADA comment:
  18.     The following program contains statements of a high-level programming
  19.     language (Ada) in a distribution considered representative:
  20.  
  21.        assignments               53 %
  22.        control statements        32 %
  23.        procedure, function calls 15 %
  24.  
  25.     100 statements are dynamically executed. The program is balanced with
  26.     respect to the three aspects:
  27.  
  28.        - statement type
  29.        - operand type (for simple data types)
  30.        - operand access
  31.             operand global, local, parameter, or constant
  32.  
  33.     The combination of these three aspects is balanced only approximately.
  34.  
  35.     The program does not compute anything meaningful, but it is syntactically
  36.     and semantically correct. All variables have a value assigned to them
  37.     before they are used as a source operand.
  38.   --------------------------------------------------------------------------- 
  39.     This Modula-2 version very closely follows the Ada version because the
  40.     two languages are similar. A loop of 50000 executions of the benchmark
  41.     and proper timing code has been added.
  42.  
  43.    Alfred Aburto, Compuserve: 76450,23 published these results for C:
  44.    ------------------------------------------------------------------------
  45.    Manx Aztec C V3.30E with some variables assigned to registers.
  46.    ------------------------------------------------------------------------
  47.    System        CPU / FPP    Clock   Cache  Memory   Time   Dhrystones/sec
  48.                               (MHz)          (bits)  (sec )
  49.    Amiga       (68000/-----)   7.16   -----    16     46.2      1083
  50.    Turbo-Amiga (68020/-----)   7.16    Off     16     54.5       917
  51.    Turbo-Amiga (68020/-----)   7.16    On      16     43.1      1160
  52.    Turbo-Amiga (68020/-----)  14.32    Off     32     18.3      2729
  53.    Turbo-Amiga (68020/-----)  14.32    On      32     16.6      3008
  54.    ------------------------------------------------------------------------
  55.    Lattice C V3.03. 'makesimple' and no register or short variables.
  56.    ------------------------------------------------------------------------
  57.    Amiga       (68000/-----)   7.16   -----    16    -----       458
  58.    Turbo-Amiga (68020/-----)   7.16    Off     16    128.7       388
  59.    Turbo-Amiga (68020/-----)   7.16    On      16     86.0       581
  60.    Turbo-Amiga (68020/-----)  14.32    Off     32     37.7      1326
  61.    Turbo-Amiga (68020/-----)  14.32    On      32     31.3      1595
  62.    ------------------------------------------------------------------------
  63.    These that follow are Lattice C V3.03 with Short Variables defined.
  64.    ------------------------------------------------------------------------
  65.    Amiga       (68000/-----)   7.16   -----    16     84.9       589
  66.    Turbo-Amiga (68020/-----)   7.16    off     16    101.8       491
  67.    Turbo-Amiga (68020/-----)   7.16    on      16     73.2       683
  68.    Turbo-Amiga (68020/-----)  14.32    off     32     29.7      1683
  69.    Turbo-Amiga (68020/-----)  14.32    on      32     25.0      2000
  70.    ------------------------------------------------------------------------
  71.    TDI Modula-2 rel. 3.00a 
  72.    ------------------------------------------------------------------------
  73.    Amiga       (68000/-----)   7.16   -----    16     -----       378  1)
  74.    Amiga       (68000/-----)   7.16   -----    16      87.4       571  2)
  75.    Amiga       (68000/-----)   7.16   -----    16     -----       613  3)
  76.    Amiga       (68000/-----)   7.16   -----    16     -----      1064  4)
  77.    ------------------------------------------------------------------------
  78.    1) Using the released Strings.Compare procedure
  79.    2) Using a recoded Strings.Compare, still full general procedure.
  80.       This is probably the figure, that should be compared to the
  81.       results above.
  82.    3) Using the Compare30 procedure below, similar to compiler generated
  83.       inline code from many compilers
  84.    4) Using no string comparison at all
  85.    ------------------------------------------------------------------------
  86.    Benchmark Modula-2 rel. 1.02 
  87.    ------------------------------------------------------------------------
  88.    Amiga       (68000/-----)   7.16   -----    16      79.3       630  1)
  89.    Amiga       (68000/-----)   7.16   -----    16      83.5       598  2)
  90.    Amiga       (68000/-----)   7.16   -----    16      86.8       576  3)
  91.    Amiga       (68000/-----)   7.16   -----    16      49.3      1012  4)
  92.    ------------------------------------------------------------------------
  93.    1) same as note 1 for TDI
  94.    2) same as note 1, except using base relative addressing (the default), as
  95.       opposed to absolute addressing which was used for entries 1,3,4
  96.    3) same as note 3 for TDI
  97.    4) hopefully same as note 4 for TDI, but I'm not sure, as I don't quite know
  98.       what was actually done in the TDI test.  All I did was comment out the
  99.       call to StringCompare and substituted it with a FALSE.
  100.   -------------------------------------------------------------------------*)
  101.  
  102. FROM Memory      IMPORT AllocMem, FreeMem, MemReqSet, MemPublic;
  103. FROM TermInOut   IMPORT WriteString, WriteCard, WriteLn;
  104. FROM LongInOut   IMPORT WriteLongCard, WriteLongInt;
  105. FROM AmigaDOS    IMPORT DateStamp, DateStampRecord, TicksPerSecond;
  106. FROM Strings     IMPORT CompareString, Relation;
  107. FROM SYSTEM      IMPORT LONG, TSIZE;
  108.  
  109. CONST
  110.   LOOPS = 50000;
  111.   Ticks = TicksPerSecond;        (* no of timer ticks in each second *)
  112.   NULL  = NIL;
  113.  
  114. TYPE
  115.   Enumeration = (Ident1, Ident2, Ident3, Ident4, Ident5);
  116.  
  117.   ZeroToThirty  = [0..30];  (*Modula-2*)
  118.   OneToThirty   = [1..30];
  119.   OneToFifty    = [1..50];
  120.   CapitalLetter = CHAR;
  121.  
  122.   String30 =      ARRAY ZeroToThirty OF CHAR;
  123.  
  124.   Array1Dim =     ARRAY OneToFifty  OF CARDINAL;
  125.   Array2Dim =     ARRAY OneToFifty, OneToFifty OF CARDINAL;
  126.  
  127.   RecordPointer   = POINTER TO RecordType;
  128.  
  129.   RecordType =
  130.   RECORD
  131.     PointerComp   : RecordPointer;
  132.     CASE Discr: Enumeration OF
  133.     Ident1:
  134.       EnumComp  : Enumeration;
  135.       IntComp   : OneToFifty;
  136.       StringComp: String30;
  137.   | Ident2:
  138.       EnumComp2  : Enumeration;
  139.       StringComp2: String30;
  140.     ELSE
  141.       CharComp1,
  142.       CharComp2:   CHAR;
  143.     END; (*CASE*)
  144.   END; (*RECORD*)
  145.  
  146. VAR
  147.   IntGlob:    CARDINAL;
  148.  
  149.   BoolGlob:   BOOLEAN;
  150.   CharGlob1,
  151.   CharGlob2:  CHAR;
  152.   ArrayGlob1: Array1Dim;
  153.   ArrayGlob2: Array2Dim;
  154.   PointerGlob,
  155.   PointerGlobNext: RecordPointer;
  156.  
  157.  
  158. PROCEDURE Compare30(VAR A, B: String30): Relation;
  159.  
  160. (* The string comparison accounts for a large part of the consumed
  161.    CPU time in this test.
  162.    This procedure is what a compiler might generate as inline code
  163.    based on the knowledge of the variables being tested.
  164. *)
  165.    
  166. VAR
  167.   i: CARDINAL;
  168.   Ai, Bi: CHAR;
  169. BEGIN
  170.   i := 0; 
  171.   LOOP
  172.     Ai := A[i]; Bi := B[i];
  173.     IF (Ai <> Bi) OR (Ai = 0C) OR (Bi = 0C) OR (i = 30) THEN EXIT; END;
  174.     INC(i);
  175.   END;
  176.  
  177.   IF Ai < Bi THEN RETURN less;
  178.   ELSIF Ai = Bi THEN RETURN equal;
  179.   ELSE  RETURN greater; END;
  180. END Compare30;
  181.  
  182.  
  183. PROCEDURE Func3(EnumParIn: Enumeration): BOOLEAN;
  184.     (*executed once, returns TRUE
  185.       EnumParIn = Ident3
  186.     *)
  187. VAR
  188.   EnumLoc: Enumeration;
  189. BEGIN
  190.   EnumLoc := EnumParIn;
  191.   IF EnumLoc = Ident3
  192.   THEN  (*executed*)
  193.     RETURN TRUE;
  194.   END;
  195.   RETURN FALSE;  (* MODULA-2 *)
  196. END Func3;
  197.  
  198.  
  199. PROCEDURE Proc6(EnumParIn: Enumeration; VAR EnumParOut: Enumeration);
  200.     (*executed once, EnumParIn = Ident3, ENumParOut  becomes Ident2*)
  201. BEGIN
  202.   EnumParOut := EnumParIn;
  203.   IF NOT Func3(EnumParIn)
  204.   THEN   (*not executed*)
  205.     EnumParOut := Ident4;
  206.   END;
  207.   CASE EnumParIn OF
  208.     Ident1: EnumParOut := Ident1;
  209.   | Ident2: IF IntGlob > 100
  210.             THEN EnumParOut := Ident1;
  211.             ELSE EnumParOut := Ident4;
  212.             END;
  213.   | Ident3: EnumParOut := Ident2;  (*executed*)
  214.   | Ident4:
  215.   | Ident5: EnumParOut := Ident3;
  216.   END;
  217. END Proc6;
  218.  
  219.  
  220. PROCEDURE Proc7(IntParIn1,
  221.                 IntParIn2: OneToFifty;
  222.             VAR IntParOut: OneToFifty);
  223.     (*executed three times,
  224.       first call:    IntParIn1 =  2, IntParIn2 =  3, IntParOut becomes 7
  225.       second call:   IntParIn1 =  6, IntParIn2 = 10, IntParOut becomes 18
  226.       third call:    IntParIn1 = 10, IntParIn2 =  5, IntParOut becomes 17
  227.     *)
  228. VAR
  229.   IntLoc: OneToFifty;
  230. BEGIN
  231.   IntLoc := IntParIn1 + 2;
  232.   IntParOut := IntParIn2 + IntLoc;
  233. END Proc7;
  234.  
  235.  
  236. PROCEDURE Proc8(VAR ArrayParInOut1: Array1Dim;
  237.                 VAR ArrayParInOut2: Array2Dim;
  238.                 IntParIn1,
  239.                 IntParIn2: OneToFifty);
  240.     (*executed once,
  241.       IntParIn1 = 3, IntParIn2 = 7
  242.     *)
  243. VAR
  244.   IntLoc: OneToFifty;
  245.   IntIndex: OneToFifty;   (*MODULA-2*)
  246. BEGIN
  247.   IntLoc := IntParIn1 + 5;
  248.   ArrayParInOut1[ IntLoc ] := IntParIn2;
  249.   ArrayParInOut1[ IntLoc + 1 ] := ArrayParInOut1[ IntLoc ];
  250.   ArrayParInOut1[ IntLoc + 30 ] := IntLoc;
  251.   FOR IntIndex := IntLoc TO IntLoc + 1 DO      (*loop body executed twice*)
  252.     ArrayParInOut2[ IntLoc, IntIndex ] := IntLoc;
  253.   END;
  254.   INC(ArrayParInOut2[ IntLoc, IntLoc - 1 ]);
  255.   ArrayParInOut2[ IntLoc + 20, IntLoc ] := ArrayParInOut1[ IntLoc ];
  256.   IntGlob := 5;
  257. END Proc8;
  258.  
  259.  
  260. PROCEDURE Func1(CharParIn1, CharParIn2: CapitalLetter): Enumeration;
  261.     (*executed three times, returns Ident1 each time*
  262.       first call:   CharParIn1 = 'H', CharParIn2 = 'R'
  263.       second call:  CharParIn1 = 'A', CharParIn2 = 'C'
  264.       third call:   CharParIn1 = 'B', CharParIn2 = 'C'
  265.     *)
  266. VAR
  267.   CharLoc1, CharLoc2: CapitalLetter;
  268. BEGIN
  269.   CharLoc1 := CharParIn1;
  270.   CharLoc2 := CharLoc1;
  271.   IF CharLoc2 # CharParIn2 THEN RETURN Ident1;  (*executed*)
  272.                            ELSE RETURN Ident2;  (*not executed*)
  273.   END;
  274. END Func1;
  275.  
  276.  
  277. PROCEDURE Func2(VAR StrParIn1, StrParIn2: String30): BOOLEAN;
  278.     (*executed once, returns FALSE
  279.       StringParIn1 = "DHRYSTONE, 1'ST STRING"
  280.       StringParIn2 = "DHRYSTONE, 2'ND STRING"
  281.     *) 
  282. VAR
  283.   IntLoc:    OneToThirty;
  284.   CharLoc:   CapitalLetter;
  285. BEGIN
  286.   IntLoc := 1;
  287.   WHILE IntLoc <= 1 DO     (*loop body executed once*)
  288.     IF Func1(StrParIn1[ IntLoc ],
  289.              StrParIn2[ IntLoc+1 ]) = Ident1
  290.     THEN  (*executed*)
  291.        CharLoc := 'A';
  292.        INC(IntLoc);
  293.     END;
  294.   END;
  295.   IF (CharLoc >= 'W') AND (CharLoc < 'Z')
  296.   THEN  (*not executed*)
  297.     IntLoc := 7;
  298.   END;
  299.   IF CharLoc = 'X'
  300.   THEN  (*not executed*)
  301.     RETURN TRUE;
  302.   ELSE  (*executed*)
  303.     IF StringCompare(StrParIn1, StrParIn2) = greater
  304.     THEN  (*not executed*)
  305.        INC(IntLoc, 7);
  306.        RETURN TRUE;
  307.     ELSE  (*executed*)
  308.        RETURN FALSE;
  309.     END;
  310.   END;
  311. END Func2;
  312.  
  313.  
  314. PROCEDURE time(): LONGCARD;
  315. VAR
  316.   DS: DateStampRecord;
  317. BEGIN
  318.   DateStamp(DS);
  319.   RETURN LONG(DS.dsMinute * (60D * Ticks) + DS.dsTick);
  320. END time;
  321.  
  322.  
  323. PROCEDURE Proc2(VAR IntParInOut: OneToFifty);
  324.     (*executed once, InParInOut = 3, becomes 7*)
  325. VAR
  326.   IntLoc:    OneToFifty;
  327.   EnumLoc:   Enumeration;
  328. BEGIN
  329.   IntLoc := IntParInOut + 10;
  330.   LOOP    (*executed once*)
  331.     IF CharGlob1 = 'A' THEN   (*executed*)
  332.        DEC(IntLoc);
  333.        IntParInOut := IntLoc - IntGlob;
  334.        EnumLoc     := Ident1;
  335.     END;
  336.     IF EnumLoc = Ident1 THEN EXIT; END;   (*TRUE*)
  337.   END;
  338. END Proc2;
  339.  
  340.  
  341. PROCEDURE Proc3(VAR PointerParOut: RecordPointer);
  342.     (*executed once, PointerParOut becomes PointerGlob (?)*)
  343. BEGIN
  344.   IF PointerGlob # NULL THEN         (*executed*)
  345.      PointerParOut := PointerGlob^.PointerComp;
  346.   ELSE                               (*not executed*)
  347.      IntGlob := 100;
  348.   END;
  349.   Proc7(10, IntGlob, PointerGlob^.IntComp);
  350. END Proc3;
  351.  
  352.  
  353. PROCEDURE Proc4();          (*without parameters*)
  354. VAR                         (*executed once     *)
  355.   BoolLoc: BOOLEAN;
  356. BEGIN
  357.   BoolLoc   := CharGlob1 = 'A';
  358.   BoolLoc   := BoolLoc OR BoolGlob;
  359.   CharGlob2 := 'B';
  360. END Proc4;
  361.  
  362.  
  363. PROCEDURE Proc5();          (*without parameters*)
  364. BEGIN                       (*executed once     *)
  365.   CharGlob1 := 'A';
  366.   BoolGlob  := FALSE;
  367. END Proc5;
  368.  
  369.  
  370. PROCEDURE Proc1(PointerParIn: RecordPointer);
  371. BEGIN
  372.   WITH PointerParIn^ DO
  373.     PointerComp^ := PointerGlob^;
  374.     IntComp := 5;
  375.     PointerComp^.IntComp := IntComp;
  376.     PointerComp^.PointerComp := PointerComp;
  377.     Proc3(PointerComp^.PointerComp);
  378.         (*PointerComp^.PointerComp = PointerGlob^.PointerComp =
  379.                                                          PointerGlobNext*)
  380.     IF PointerComp^.Discr = Ident1 THEN
  381.       PointerComp^.IntComp := 6;
  382.       Proc6(EnumComp, PointerComp^.EnumComp);
  383.       PointerComp^.PointerComp := PointerGlob^.PointerComp;
  384.       Proc7(PointerComp^.IntComp, 10, PointerComp^.IntComp);
  385.     ELSE
  386.       PointerParIn^ := PointerComp^;
  387.     END;
  388.   END;
  389. END Proc1;
  390.  
  391.  
  392. PROCEDURE Proc0();
  393. VAR
  394.   IntLoc1,
  395.   IntLoc2,
  396.   IntLoc3:    OneToFifty;
  397.   CharLoc,
  398.   CharIndex:  CHAR;
  399.   EnumLoc:    Enumeration;
  400.   StringLoc1,
  401.   StringLoc2: String30;
  402.  
  403.   starttime,
  404.   benchtime,
  405.   nulltime  : LONGCARD;
  406.   i:          CARDINAL;
  407.  
  408. BEGIN
  409.   (* initializations *)
  410.   PointerGlobNext := AllocMem (TSIZE (RecordType), MemReqSet{MemPublic});
  411. (*  NEW(PointerGlobNext); *)
  412.   PointerGlob := AllocMem (TSIZE (RecordType), MemReqSet{MemPublic});
  413. (*  NEW(PointerGlob); *)
  414.   WITH PointerGlob^ DO
  415.     PointerComp    := PointerGlobNext;
  416.     Discr          := Ident1;
  417.     EnumComp       := Ident3;
  418.     IntComp        := 40;
  419.     StringComp     := "DHRYSTONE PROGRAM, SOME STRING";
  420.   END;
  421.  
  422.   StringLoc1         := "DHRYSTONE PROGRAM, 1'ST STRING";
  423.   ArrayGlob2[8][7]   := 10;
  424.  
  425.   (*-------------------*)
  426.   (* get loop overhead *)
  427.   (*-------------------*)
  428.  
  429.   starttime := time();
  430.  
  431.   FOR i := 0 TO LOOPS DO
  432.   END;
  433.   nulltime := time() - starttime;
  434.  
  435.   (*-------------*)
  436.   (* start timer *)
  437.   (*-------------*)
  438.  
  439.   starttime := time();
  440.  
  441.   FOR i := 0 TO LOOPS DO
  442.     Proc5();
  443.     Proc4();
  444.         (* CharGlob1 = 'A', CharGlob2 = 'B', BoolGlob = FALSE *)
  445.     IntLoc1 := 2;
  446.     IntLoc2 := 3;
  447.     StringLoc2 := "DHRYSTONE PROGRAM, 2'ND STRING";
  448.     EnumLoc := Ident2;
  449.     BoolGlob := NOT Func2(StringLoc1, StringLoc2);
  450.         (* BoolGlob = TRUE *)
  451.  
  452.     WHILE IntLoc1 < IntLoc2 DO                (*loop body executed once*)
  453.       IntLoc3 := 5 * IntLoc1 - IntLoc2;       (*IntLoc3 = 7*)
  454.       Proc7(IntLoc1, IntLoc2, IntLoc3); (*IntLoc3 = 7*)
  455.       INC(IntLoc1);
  456.     END; (* WHILE, IntLoc1 = 3*)
  457.     Proc8(ArrayGlob1, ArrayGlob2, IntLoc1, IntLoc3); (*IntGlob = 5*)
  458.  
  459.     Proc1(PointerGlob);
  460.     FOR CharIndex := 'A' TO CharGlob2 DO      (*loop body executed twice*)
  461.       IF EnumLoc = Func1(CharIndex, 'C') THEN (*not executed*)
  462.         Proc6(Ident1, EnumLoc);
  463.       END;
  464.     END; (*FOR*)
  465.         (*EnumLoc = Ident1
  466.           IntLoc1 = 3, IntLoc2 = 3, IntLoc3 = 7 *)
  467.     IntLoc3 := IntLoc2 * IntLoc1;
  468.     IntLoc2 := IntLoc3 DIV IntLoc1;
  469.     IntLoc2 := 7 * (IntLoc3 - IntLoc2) - IntLoc1;
  470.     Proc2(IntLoc1);
  471.   END; (* FOR *)
  472.  
  473.  (*------------*)
  474.  (* stop timer *)
  475.  (*------------*)
  476.  
  477.   benchtime := time() - starttime - nulltime;
  478.   WriteString("Dhrystone time for "); WriteCard(LOOPS, 5);
  479.   WriteString(" passes = ");
  480.   nulltime := benchtime DIV LONGCARD(Ticks);
  481.   WriteLongCard(nulltime, 4); WriteString(".");
  482.   WriteLongCard((benchtime * 10D DIV LONGCARD(Ticks)) MOD 10D, 1); WriteLn;
  483.   WriteString("This machine benchmarks at ");
  484.   WriteLongCard(LONGCARD(LOOPS) * LONGCARD(Ticks) DIV benchtime, 5);
  485.   WriteString(" dhrystones/second"); WriteLn;
  486.   FreeMem (PointerGlob, TSIZE (RecordType));
  487.   FreeMem (PointerGlobNext, TSIZE (RecordType));
  488. END Proc0;
  489.  
  490. BEGIN
  491.   Proc0();
  492. END Dhrystone.
  493.